use strict;
package Data::Form::Field::Base;

use Carp;

use base qw(Class::Accessor::Assert);

#use overload
#  '""' => sub { shift->label },
#  bool => sub { shift->valid ? 1 : 0 },
#  fallback => 1;

our @attributes =
   qw( id default validators value errors label +name input_hint help );
our @flags = qw( readonly required valid many );

__PACKAGE__->mk_accessors( @attributes, @flags );

our $VERSION = '0.01_01';

#===============================================================================
# Object and Data Initilization
#

sub new {
	my $class = shift;
	return $class->SUPER::new( {@_})
}
#sub init {
#    my $class = shift;
#    my $obj   = $class->new(@_);
#    $obj->reset;
#    $obj;
#}

sub reset {
    my $self = shift;
    $self->valid(undef);
    $self->value( $self->default || undef );
    delete $self->{errors};
    1;
}

sub add_errors {
    my $self   = shift;
    foreach my $err (@_) {
        $self->add('errors', sprintf( $err, $self ) );
    }
	$self->valid(0);
    $self->errors();
}

sub fill_in {
    my ($self) = shift;
    croak "$self is a readonly field" if $self->readonly;
    $self->value(@_);
    $self->validate;
}

sub pre_fill {
    my ($self) = shift;
    croak "$self is a readonly field" if $self->readonly;
    $self->value(@_);
}

sub label {
	my $self = shift;
	if (@_){
		$self->set('label', shift);
	}
	unless ( $self->get('label') ){
		$self->set('label', ucfirst join " ", split( /_/, lc $self->get('name') ))
	}

	$self->get('label');
}

#===============================================================================
# Validation Routines
#

sub valid {
	my $self = shift;
	$self->errors ? 0 : 1;
}

sub validate {

    my $self = shift;

    # Not required and no values
    if ( not $self->required and not $self->value ) {
        return;# why continue?
    }

    # Required field needs info
    if ( $self->required and not $self->value ) {
    	my $msg = 'VALUE_REQUIRED';
    	$msg = $self->required if $self->required != 1;
        $self->add_errors($msg);
    }

    # Fields do not have more info than they are allowed
    if ( ( ref($self->value) eq 'ARRAY') and ( @{ $self->value } > 1 ) and ( not $self->many ) ) {
        $self->add_errors('ONLY_ONE_ALLOWED');
    }

    if ( $self->validators ) {
        return $self->validate_custom;
    }

    return $self->errors;

}


sub validate_custom {
    my $self = shift;

    # Do custom validation routines
    
    my %table;
    %table = (
    	CODE	=> '_check_value_code',
    	REGEXP	=> '_check_value_regex'
    );
    
    while ( my ( $msg, $test ) = each %{ $self->validators() } ) {
		my $test_type = $table{ ref($test) };
		if (defined $test_type ){
			no strict 'refs';
			$self->add_errors($msg) unless $test_type->($test, $self->value) 
		}

        #if ( ref($test) eq 'CODE' ) {
        #    $self->add_errors($msg)
        #      unless _check_value_code( $test, $self->value );
        #}
        #elsif ( ref($test) eq 'REGEXP' ) {
        #    $self->add_errors($msg)
        #      unless _check_value_regex( $test, $self->value );
        #}
        else {
            carp "Value of a validator must be a compiled REGEX or a CODE ref\n";
        }
    }

    # No errors so it must be valid
    $self->valid(1) unless $self->errors;
    $self->valid;
}

sub _check_value_regex {

    my ( $regex, @data ) = @_;
    my $i;

    for (@data) {
        $i++ if /$regex/;
    }

    return $i == @data ? 1 : 0;

}

sub _check_value_code {
    my ( $code, @data ) = @_;
    my $i;

    for (@data) {
        $i++ if $code->($_);
    }

    return $i == @data ? 1 : 0;

}

#========================================================================================
# Additions to Class::Accessor
#

sub get {

    my ($self) = shift;

    if ( @_ == 1 ) {
        return $self->{ $_[0] } unless wantarray;
        my $values = $self->{ $_[0] };
        return @$values if ( ref($values) eq 'ARRAY' );
        #return %$values if ( ref($values) eq 'HASH' );
        return $values;
    }
    elsif ( @_ > 1 ) {
        return @{$self}{@_};
    }
    else {
        croak("Wrong number of arguments received.");
    }
}

sub add {
    my $self   = shift;
    my $member = shift;

    my $values = $self->get($member);

    unless ( defined $values ) {
        return $self->set( $member, @_ );
    }

    if ( ref($values) eq 'ARRAY' ) {

        return $self->set( $member, @$values, @_ );
    }

    if ( ref($values) eq 'HASH' ) {

        croak "Odd number of elements in hash" if @_ % 2;
        return $self->set( $member, %$values, @_ );

    }

    $self->set( $member, $values );
}

1;
__END__
=head1 NAME

Data::Form::Base - Base attributes and behaviour for field objects

=head1 SYNOPSIS

   package My::Form::Field::Email;

   use base qw(Data::Form::Field::Base);
   use Email::Valid;
   
   sub validate {
       my $self = shift;

        # The base class will check requiredness for us
        return if $self->SUPER::validate;

        if (not  Email::Valid->address( $self->value  ) )
        {
    	    # Just use a text token the template will turn it into a useful message
            $self->add_errors("INVALID EMAIL");
        }

        return $self->errors;
   }

   1;

   package main;
   use Data::Form;
   
   my $form = Data::Form->new(
   				name  => { required => 1 },
   				email => { required => 1,
   						   type     => 'My::Form::Field::Email' },
   );

=head1 SEE ALSO

=over 4

=item * L<Data::Form::Field::Option>

=item * L<Data::Form::Field::Text>

=item * L<Data::Form::Field::Boolean>

=back 

=head1 AUTHOR

Clayton Scott, E<clscott@cpan.org>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2007 by Clayton Scott

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.8 or,
at your option, any later version of Perl 5 you may have available.

=cut